perm filename EXPRS.SAI[AL,HE]3 blob
sn#339091 filedate 1978-03-03 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
C00005 00003 ! getfrec, putfrec, etc.
C00008 00004 ! new_fluent,new_set_fluent,new_var,new_lbl,asglbl,bldcalc,blcchg
C00013 00005 ! vnode managers: GEN_DEPS, GEN_CHANGERS, GEN_CALCS, COPYVN, OKVNGET
C00016 00006 ! graph node procedures
C00024 00007 ifcr false thenc ! make_var
C00025 00008 ! expeqv
C00027 00009 ! invsimp
C00029 00010 ! evalexpr
C00035 00011 ! graph munchers
C00039 00012 ifcr false thenc ! modified graph munchers
C00043 00013 ! yet another version of graph munchers
C00048 ENDMK
C⊗;
IFCR ¬DECLARATION(EXTENDED_COMPILATION) THENC
ENTRY; COMMENT Requirements, initialization of constants;
BEGIN "EXPRS"
DEFINE EXPRS_TERNAL = "INTERNAL";
DEFINE PDVSW = "TRUE"; COMMENT THIS FILE GETS THE PDV'S;
IFCR ¬ DECLARATION(CREFFING) THENC DEFINE CREFFING = "FALSE";ENDC
IFCR ¬ CREFFING THENC
REQUIRE "ALREQ.HDR[AL,HE]" SOURCE_FILE;
REQUIRE "GOBBLE.HDR[AL,HE]" SOURCE_FILE;
ENDC
REDEFINE $$PRGID "[]" = ["EXPRS"];
IFCR CREFFING THENC REQUIRE $$PRGID MESSAGE;ENDC
ENDC
SIMPLE PROCEDURE FLPRT(INTEGER FLL);
PRINT("<FLUENT ",CVOS(FLL),">");
SIMPLE PROCEDURE SFLPRT(INTEGER FLL);
PRINT("<SET_FLUENT ",CVOS(FLL),">");
INITIALIZE(SETRPM(LOC(FLUENT),LOCATION(FLPRT)));
INITIALIZE(SETRPM(LOC(SET_FLUENT),LOCATION(SFLPRT)));
INTERNAL INTEGER VARNO;INITIALIZE (VARNO←0);
INTERNAL INTEGER CURTIME;
INTERNAL ITEMVAR CURWLD;
INTERNAL RPTR(VALU$) VOLD,VNEW; ! *** (RHT) These are part of kluge
to make VCHANGE do the "right" thing
with ALSO_DO. ***;
PROCEDURE EXPINI;
BEGIN
CURTIME←1;
CURWLD←XITEM("INITIALLY");
END;
REQUIRE EXPINI INITIALIZATION;
! getfrec, putfrec, etc. ;
INTERNAL RANY PROCEDURE GETFREC(RPTR(FLUENT) FL;ITEMVAR WLD;BOOLEAN NONUSE(FALSE));
BEGIN
! fetches the correct record for FL in world WLD.
remembers the result in FL;
IF FLUENT:FACTID[FL]≠NULL_RECORD ∧ TRUE_IN(FLUENT:FACTID[FL],WLD) THEN
BEGIN
IF ¬ NONUSE THEN
USEFCT(FLUENT:FACTID[FL],WLD);
_FACT_←FLUENT:FACTID[FL];
RETURN(FLUENT:FREC[FL]);
END;
IF PMATCH(WLD,FLUENT:RETRPATT[FL],NONUSE) THEN
BEGIN
FLUENT:FACTID[FL]←_FACT_;
FLUENT:FREC[FL]←FRTEMP;
RETURN(FRTEMP);
END;
_FACT_←NULL_RECORD;
RETURN(NULL_RECORD);
END;
INTERNAL RANY PROCEDURE PUTFREC(RANY FR;RPTR(FLUENT) FL;ITEMVAR WLD);
BEGIN
! store FR for fluent FL in world WLD;
INTEGER WIX;
WIX←WLDINX(WLD);
IF TSTWIX(FLUENT:FACTID[FL],WIX) THEN
DENYF(WLD,FLUENT:FACTID[FL]);
FLUENT:FREC[FL]←FR;
FLUENT:FACTID[FL]←LPASRT(WLD,\($ FL,$ FR));
RETURN(FR);
END;
INTERNAL PROCEDURE NOFREC(ITEMVAR WLD;RPTR(FLUENT) FL);
BEGIN
GETFREC(FL,WLD,TRUE);
IF _FACT_≠NULL_RECORD THEN
DENYF(WLD,_FACT_);
END;
INTERNAL RECURSIVE MATCHING PROCEDURE SATISFY_SET_FLUENT(? ITEMVAR WLD;
RPTR(SET_FLUENT) SFL;REFERENCE RANY R);
BEGIN
∀ ? WLD | PMATCH(WLD,SET_FLUENT:RETRPATT[SFL]) DO
BEGIN
R←FRTEMP;
SUCCEED;
END;
END;
INTERNAL PROCEDURE PUT_SET_FLUENT(ITEMVAR WLD;RPTR(SET_FLUENT) SFL;RANY R);
LPASRT(WLD,\($ SFL,$ R));
INTERNAL PROCEDURE REM_SET_FLUENT(ITEMVAR WLD;RPTR(SET_FLUENT) SFL;RANY R);
LPDENY(WLD,\($ SFL,$ R));
! new_fluent,new_set_fluent,new_var,new_lbl,asglbl,bldcalc,blcchg;
INTERNAL RANY FRTEMP;
INTERNAL RPTR(FLUENT) PROCEDURE NEW_FLUENT;
BEGIN
! creates a new fluent record & sets up pointers;
RPTR(FLUENT) FL;
FL←NEW_RECORD(FLUENT);
FLUENT:RETRPATT[FL]←PATTBLK(\($ FL,BIND FRTEMP));
RETURN(FL);
END;
INTERNAL RPTR(SET_FLUENT) PROCEDURE NEW_SET_FLUENT;
BEGIN
RPTR(SET_FLUENT) SFL;
SFL←NEW_RECORD(SET_FLUENT);
SET_FLUENT:RETRPATT[SFL]←PATTBLK(\($ SFL,BIND FRTEMP));
RETURN(SFL);
END;
INTERNAL RPTR(VARIABLE) PROCEDURE NEW_VAR(RANY ITEMVAR IV;
INTEGER DT;RPTR(BLOCK) BID);
BEGIN
RPTR(VARIABLE) VAR;
VAR←NEW_RECORD(VARIABLE);
VARIABLE:PLNVAL[VAR]←NEW_FLUENT;
VARIABLE:CALCS[VAR]←NEW_SET_FLUENT;
VARIABLE:DEPS[VAR]←NEW_SET_FLUENT;
VARIABLE:CHANGERS[VAR]←NEW_SET_FLUENT;
VARIABLE:NAME[VAR]←IV;
∂(IV)←VAR;
VARIABLE:DATATYPE[VAR]←DT;
VARIABLE:BLK[VAR]←BID;
IF BID≠NULL_RECORD THEN
BEGIN
IF DT=EVENT_DTYPE THEN
CONSON(VAR,BLOCK:EVTS[BID])
ELSE
CONSON(VAR,BLOCK:VARS[BID]);
END;
RETURN(VAR);
END;
INTERNAL RPTR(LBLVAR) PROCEDURE NEW_LBL(RANY ITEMVAR IV;
INTEGER DT;RPTR(BLOCK) BID);
BEGIN
RPTR(LBLVAR) L;
L←NEW_RECORD(LBLVAR);
LBLVAR:DATATYPE[L]←DT;
LBLVAR:BLK[L]←BID;
IF IV=ANY THEN
IV←NEW(L)
ELSE
∂(IV)←L;
LBLVAR:NAME[L]←IV;
RETURN(L);
END;
INTERNAL RPTR(CHANGER) PROCEDURE BLDCHG(RPTR(STMNT) S;RPTR(BLOCK) BID);
BEGIN
RPTR(CHANGER) CHG;
CHG←NEW_RECORD(CHANGER);
CHANGER:CODE[CHG]←S;
CHANGER:BLID[CHG]←BID;
CHANGER:TRIGGERS[CHG]←NEW_SET_FLUENT;
IF BID≠NULL_RECORD THEN
CONSON(CHG,BLOCK:ALSOS[BID]);
RETURN(CHG);
END;
INTERNAL RPTR(CALCULATOR) PROCEDURE BLDCALC(ITEMVAR WLD;RPTR(EXPRN) E;
RPTR(BLOCK) BID);
BEGIN
RPTR(CALCULATOR) CLC;
CLC←NEW_CALC(E);
MK_CALC(WLD,CLC);
IF BID≠NULL_RECORD THEN
CONSON(CLC,BLOCK:CLCS[BID]);
RETURN(CLC);
END;
INTERNAL RANY PROCEDURE ASGLBL(RPTR(LBLVAR) L;RPTR(ANY_CLASS) SEM);
BEGIN
INTEGER IX;BOOLEAN OK;
IX←RECTYPE(SEM);
OK←FALSE;
CASE LBLVAR:DATATYPE[L] OF
BEGIN
[CHGLAB_DTYPE] IF IX=LOC(CHANGER) THEN
BEGIN
CHANGER:LBL[SEM]←L;
OK←TRUE;
END;
[CLCLAB_DTYPE] IF IX=LOC(CALCULATOR) THEN
BEGIN
CALCULATOR:LBL[SEM]←L;
OK←TRUE;
END;
[STMLAB_DTYPE] IF IX=LOC(STMNT) THEN ! need to have the stmnt point to the label;
BEGIN
STMNT:STLAB[SEM] ← L;
OK←TRUE;
END;
[OMNLAB_DTYPE] IF IX=LOC(CMON) THEN OK←TRUE
ELSE IF IX=LOC(STMNT) ∧ RECTYPE(STMNT:SEMANTICS[SEM])=LOC(CMON) THEN
BEGIN ! point to the cmon itself;
OK ← TRUE;
SEM ← STMNT:SEMANTICS[SEM];
END
END;
IF ¬OK THEN
USERERR(1,1,"TYPE MISMATCH IN ASGLBL");
LBLVAR:SEMANTICS[L]←SEM;
RETURN(SEM);
END;
! vnode managers: GEN_DEPS, GEN_CHANGERS, GEN_CALCS, COPYVN, OKVNGET;
INTERNAL MATCHING RECPROC GEN_DEPS(ITEMVAR WLD;RPTR(VARIABLE,CALCULATOR) VAR;
REFERENCE RPTR(VARIABLE) DV);
BEGIN
RPTR(SET_FLUENT) DPS;
IF RECTYPE(VAR)=LOC(CALCULATOR) THEN
DPS←CALCULATOR:DEPS[VAR]
ELSE
DPS←VARIABLE:DEPS[VAR];
∀ | SATISFY_SET_FLUENT(WLD,DPS,DV) DO SUCCEED;
END;
INTERNAL MATCHING RECPROC GEN_CHANGERS(ITEMVAR WLD;RPTR(VARIABLE) VAR;
REFERENCE RPTR(CHANGER) DV);
BEGIN
∀ | SATISFY_SET_FLUENT(WLD,VARIABLE:CHANGERS[VAR],DV) DO
IF RECTYPE(DV)=LOC(CHANGER) THEN
SUCCEED
ELSE
BUG("A NON-CHANGER");
END;
INTERNAL MATCHING RECPROC GEN_CALCS(ITEMVAR WLD;RPTR(VARIABLE) VAR;
REFERENCE RPTR(CALCULATOR) DV);
BEGIN
∀ | SATISFY_SET_FLUENT(WLD,VARIABLE:CALCS[VAR],DV) DO SUCCEED;
END;
INTERNAL RPTR (VNODE) PROCEDURE COPYVN(RPTR(VNODE) GN1);
BEGIN
! return a copy of graph node GN1;
RPTR(VNODE) GN2;
GN2←NEW_RECORD(VNODE);
VNODE:INVMARK[GN2]←VNODE:INVMARK[GN1];
VNODE:NOMVAL[GN2]←VNODE:NOMVAL[GN1];
RETURN(GN2);
END;
INTERNAL RPTR(VNODE) PROCEDURE OKVNGET(RPTR(VARIABLE,CALCULATOR) VAR;ITEMVAR WLD);
BEGIN
! returns a graph node for VAR which may be modified in
world WLD without causing strange side effects in other
worlds;
RPTR(VNODE) GN;
RPTR(FLUENT) FL;
IF RECTYPE(VAR)=LOC(CALCULATOR) THEN
FL←CALCULATOR:PLNVAL[VAR]
ELSE
FL←VARIABLE:PLNVAL[VAR];
GN←GETFREC(FL,WLD,TRUE); ! not a "rememberable" use;
IF GN=NULL_RECORD THEN
BEGIN
GN←NEW_RECORD(VNODE);
VNODE:INVMARK[GN]←-1; ! new node lacks a valid value;
PUTFREC(GN,FL,WLD);
END
ELSE IF FACT:USECNT[FLUENT:FACTID[FL]]>1 THEN
BEGIN
CLRWLD(FLUENT:FACTID[FL],WLDINX(WLD));
GN←COPYVN(GN);
PUTFREC(GN,FL,WLD);
END;
RETURN(GN);
END;
! graph node procedures;
! These routines perform graph node operations in a named planning world.
Their individual actions are those specified in the AL report. ;
RECURSIVE PROCEDURE INVAL0(RPTR(VARIABLE,CALCULATOR) VAR;
ITEMVAR WLD;REFERENCE SET INVLSEEN);
BEGIN
! procedure used as working loop of invalidate:
(1) looks to see if it has already invalidated VAR by
checking whether id of VAR is in INVLSEEN.
(2) if plnval fluent is null or valid, then
gets a fluent & sets INVMARK to -1.
(3) proceddes all dependent nodes.
;
INTEGER RT,IDNO;
RPTR(VNODE) GN;
RPTR(VARIABLE) DV;
IDNO←MEMORY[LOCATION(VAR)]; ! very bad hack;
IF CVI(IDNO)εINVLSEEN THEN
RETURN;
PUT CVI(IDNO) IN INVLSEEN;
RT←RECTYPE(VAR);
IF RT=LOC(CALCULATOR) THEN
GN←GETFREC(CALCULATOR:PLNVAL[VAR],WLD,TRUE)
ELSE IF RT=LOC(VARIABLE) THEN
GN←GETFREC(VARIABLE:PLNVAL[VAR],WLD,TRUE)
ELSE
BUG("BAD ARGUMENT TO INVAL0");
IF GN=NULL_RECORD OR VNODE:INVMARK[GN]=0 THEN
BEGIN
GN←OKVNGET(VAR,WLD);
VNODE:INVMARK[GN]←-1;
END;
∀ | GEN_DEPS(WLD,VAR,DV) DO
INVAL0(DV,WLD,INVLSEEN);
END;
INTERNAL RPTR(VNODE) RECURSIVE PROCEDURE INVALIDATE(RPTR(VARIABLE,CALCULATOR) VAR;
ITEMVAR WLD);
BEGIN
SET INVLSEEN;
INVLSEEN←PHI;
INVAL0(VAR,WLD,INVLSEEN);
RETURN(OKVNGET(VAR,WLD));
END;
RECURSIVE RPTR(VNODE) PROCEDURE EVALVAR(RPTR(VARIABLE) VAR;INTEGER T;ITEMVAR WLD);
BEGIN
RPTR(VNODE) GN,EVN;
RPTR(CALCULATOR) C;
LABEL EWON;
GN←GETFREC(VARIABLE:PLNVAL[VAR],WLD);
! see if we already have a valid value;
IF GN ≠ NULL_RECORD THEN
IF (VNODE:INVMARK[GN]=0 ∨ VNODE:INVMARK[GN]=T) THEN
RETURN(GN);
GN←OKVNGET(VAR,WLD);
VNODE:INVMARK[GN]←T;
∀ | GEN_CALCS(WLD,VAR,C) DO
BEGIN "CLOOP"
EVN←GETFREC(CALCULATOR:PLNVAL[C],WLD);
IF EVN≠RNULL ∧ VNODE:INVMARK[EVN]=0 THEN
GO TO EWON;
END;
∀ | GEN_CALCS(WLD,VAR,C) DO
BEGIN
EVN←EVALCALC(C,T,WLD);
IF EVN≠RNULL ∧ VNODE:INVMARK[EVN]=0 THEN
GO TO EWON;
END;
RETURN(GN); ! we did the best we could;
EWON: VNODE:INVMARK[GN]←0;VNODE:NOMVAL[GN]←VNODE:NOMVAL[EVN];
RETURN(GN);
END;
INTERNAL RECURSIVE RPTR(VNODE) PROCEDURE EVALCALC(RPTR(CALCULATOR) CLC;
INTEGER T;
ITEMVAR WLD);
BEGIN
RPTR(VNODE) GN;
RPTR(VARIABLE,CALCULATOR) ITEMVAR VI;
GN←GETFREC(CALCULATOR:PLNVAL[CLC],WLD);
IF GN ≠ RNULL THEN
IF VNODE:INVMARK[GN]=0 ∨ VNODE:INVMARK[GN]=T THEN RETURN(GN);
GN←OKVNGET(CLC,WLD);
VNODE:INVMARK[GN]←T;
∀ VI | VI ε CALCULATOR:NEEDED[CLC] DO
BEGIN
IF VNODE:INVMARK[EVALNODE(∂(VI),T,WLD)]≠0 THEN
RETURN(GN);
END;
VNODE:INVMARK[GN]←0;
VNODE:NOMVAL[GN]←EVALEXPR(CALCULATOR:FORM[CLC],WLD);
RETURN(GN);
END;
INTERNAL RPTR(VNODE) PROCEDURE EVALNODE(RPTR(VARIABLE,CALCULATOR) VAR;
INTEGER T;ITEMVAR WLD);
BEGIN
IF RECTYPE(VAR)=LOC(VARIABLE) THEN
RETURN(EVALVAR(VAR,T,WLD))
ELSE
RETURN(EVALCALC(VAR,T,WLD))
END;
INTERNAL RECURSIVE RPTR(VALU$) PROCEDURE GETVALUE(RPTR(VARIABLE) VAR;
ITEMVAR WLD);
BEGIN
RPTR(VNODE) GN;
INTEGER DUMMY;
GN←GETFREC(VARIABLE:PLNVAL[VAR],WLD);
IF GN=RNULL ∨ VNODE:INVMARK[GN]≠0 THEN
GN←EVALNODE(VAR,CURTIME←CURTIME+1,WLD);
IF GN = RNULL ∨ VNODE:INVMARK[GN]≠0 THEN
BEGIN
USERERR(1,1,"GETVALUE: "&ITMNAM(VARIABLE:NAME[VAR])
& " has no plan value");
CASE VARIABLE:DATATYPE[VAR] OF
BEGIN ! really return something so we;
[SVAL_DTYPE] RETURN(FALSEV); ! don't generate more error;
[V3ECT_DTYPE] RETURN(NILVECT); ! messages than need be;
[ROTN_DTYPE] RETURN(NILROTN);
[TRANS_DTYPE] RETURN(NILTRANS);
[FRAME_DTYPE] RETURN(NILDEPROACH);
ELSE RETURN(RNULL)
END
END;
RETURN(VNODE:NOMVAL[GN]);
END;
INTERNAL INTEGER SIMPLE PROCEDURE DTYPE(INTEGER DT);
START_CODE
MOVE 0,DT; ! this is cretinous, but ...;
MOVEI 1,0;
CAIN 0,SVAL_DTYPE;
MOVEI 1,SVAL;
CAIN 0,V3ECT_DTYPE;
MOVEI 1,V3ECT;
CAIN 0,ROTN_DTYPE;
MOVEI 1,ROTN;
CAIN 0,TRANS_DTYPE;
MOVEI 1,TRANS;
CAIN 0,FRAME_DTYPE;
MOVEI 1,FRAME;
END;
INTERNAL RPTR(VALU$) PROCEDURE VTCHECK(RPTR(VARIABLE) VAR;RPTR(VALU$) VAL);
BEGIN
INTEGER DT,VART;
DT←VARIABLE:DATATYPE[VAR];
VART←RECTYPE(VAL);
IF VART≠DTYPE(DT) THEN
BEGIN
IF DT=FRAME_DTYPE ∧ VART=LOC(TRANS) THEN
RETURN(NEW_FRAME(VAL))
ELSE
USERERR(1,1,"TYPE MISMATCH IN VTCHECK");
END;
RETURN(VAL);
END;
INTERNAL RECURSIVE PROCEDURE VCHANGE(RPTR(VARIABLE) VAR;
RPTR(VALU$) NEWV;ITEMVAR WLD);
BEGIN
RPTR(VNODE) GN;
RPTR(CHANGER) CH;
RPTR(STMNT) S;
RPTR(VALU$) VOLDSAVE,VNEWSAVE;
SIMPLE PROCEDURE PUTONVBACK;
BEGIN
VOLD←VOLDSAVE;VNEW←VNEWSAVE;
END;
CLEANUP PUTONVBACK;
VOLDSAVE←VOLD;VNEWSAVE←VNEW;
GN←INVALIDATE(VAR,WLD);
VOLD←VNODE:NOMVAL[GN];
VNEW←VTCHECK(VAR,NEWV);
VNODE:NOMVAL[GN]←VNEW;
VNODE:INVMARK[GN]←0;
∀ | GEN_CHANGERS(WLD,VAR,CH) DO
BEGIN
S←CHANGER:CODE[CH];
STMNT:IW[S]←STMNT:OW[S]←WLD;
STINTERP(S);
END;
END;
ifcr false thenc ! make_var;
INTERNAL RPTR(VARIABLE) PROCEDURE MAKE_VAR(STRING ID;
INTEGER DT;RPTR(VALU$) V;ITEMVAR WLD);
BEGIN
INTEGER FG;
RANY ITEMVAR IV;
IV←CVSI(ID,FG);
IF FG THEN
BEGIN
IV←NEW(NULL_RECORD);
NEW_PNAME(IV,ID);
END;
NEW_VAR(IV,DT,NULL_RECORD);
VCHANGE(∂(IV),V,WLD);
RETURN(∂(IV));
END;
endc
! expeqv;
! Symbolic comparison of expressions. not very bright about
commutative laws, etc. Returns TRUE if it thinks that E1 ≡ E2;
INTERNAL RECURSIVE BOOLEAN PROCEDURE EXPEQV(RPTR(EXPRN,VALU$,VARIABLE) E1,E2);
BEGIN
INTEGER T1,T2;
IF E1 = E2 THEN RETURN(TRUE);
T1←RECTYPE(E1);T2←RECTYPE(E2);
IF T1≠ T2 THEN RETURN(FALSE);
IF T1= LOC(VARIABLE) THEN RETURN(FALSE); ! had to be eq;
IF T1= LOC(SVAL) THEN RETURN(SVAL:VAL[E1]=SVAL:VAL[E2]);
IF T1= LOC(V3ECT) THEN RETURN(V3CMP(E1,E2)=0);
IF T1= LOC(ROTN) THEN RETURN(ROTCMP(E1,E2)=0);
IF T1= LOC(TRANS) THEN RETURN(TRANSCMP(E1,E2)=0);
IF T1= LOC(FRAME) THEN RETURN(TRANSCMP(FRAME:VAL[E1],FRAME:VAL[E2])=0);
IF T1= LOC(EXPRN) THEN
BEGIN
RCELL C1,C2;
IF EXPRN:OP[E1]≠EXPRN:OP[E2] THEN RETURN(FALSE);
IF EXPRN:DATATYPE[E1]≠EXPRN:DATATYPE[E2] THEN RETURN(FALSE);
C1←EXPRN:ARGS[E1];C2←EXPRN:ARGS[E2];
WHILE C1≠NULL_RECORD ∧ C2≠NULL_RECORD DO
BEGIN
IF ¬EXPEQV(CELL:CAR[C1],CELL:CAR[C2]) THEN
RETURN(FALSE);
C1←CELL:CDR[C1];
C2←CELL:CDR[C2];
END;
RETURN(C1=C2);
END;
USERERR(1,1,"EXPEQV: CONFUSION");
RETURN(FALSE);
END;
! invsimp;
INTERNAL REXPR RECPROC INVSIMP(REXPR E);
BEGIN
REXPR EE;RCELL C,CC;
BOOLEAN FLAG;
IF RECTYPE(E)≠LOC(EXPRN) THEN
RETURN(E);
FLAG←FALSE;
C←EXPRN:ARGS[E];
IF EXPRN:OP[E]=TINVRT_OP THEN
BEGIN
EE←INVSIMP(CELL:CAR[C]);
IF RECTYPE(EE)=LOC(EXPRN) THEN
BEGIN
IF EXPRN:OP[EE]=TINVRT_OP THEN
RETURN(CELL:CAR[EXPRN:ARGS[EE]])
END;
IF EE≠CELL:CAR[C] THEN
BEGIN
FLAG←TRUE;
CC←CONS(EE,NULL_RECORD)
END;
END
ELSE WHILE C≠NULL_RECORD DO
BEGIN
EE←INVSIMP(LLOP(C));
CC←APPEND(CC,CONS(EE,NULL_RECORD));
FLAG←TRUE;
END;
IF FLAG THEN
RETURN(NEW_EXPRN(EXPRN:DATATYPE[E],EXPRN:OP[E],CC))
ELSE
RETURN(E);
END;
! evalexpr ;
RPTR(VALU$) PROCEDURE TFCVT(RPTR(VALU$) V);
IF RECTYPE(V)=LOC(FRAME) THEN RETURN(FRAME:VAL[V])
ELSE RETURN(V);
INTERNAL RPTR(VALU$) RECPROC EVALEXPR(RPTR(NOMV,SPECVAL,EXPRN,VARIABLE,VALU$) E;
ITEMVAR WLD);
BEGIN
! evaluates the planning value of expression-like thing E in
world WLD & returns a value (e.g., vector, sval, trans) ;
RPTR(CELL) C;
RPTR(VALU$) V1,V2,V3;
INTEGER ETYP;
LABEL REEVAL;
REEVAL: IF E=NULL_RECORD THEN RETURN(E);
ETYP←RECTYPE(E);
IF ETYP=LOC(VARIABLE) THEN
RETURN(GETVALUE(E,WLD))
ELSE IF ETYP=LOC(SPECVAL) THEN
BEGIN
IF SPECVAL:OLD[E] THEN RETURN(VOLD) ELSE RETURN(VNEW);
END
ELSE IF ETYP=LOC(SVAL) ∨ ETYP=LOC(FRAME) ∨ ETYP=LOC(TRANS) ∨
ETYP=LOC(V3ECT) ∨ ETYP=LOC(ROTN) THEN
RETURN(E)
ELSE IF ETYP=LOC(NOMV) THEN
BEGIN
IF NOMV:WLD[E]≠ANY THEN WLD←NOMV:WLD[E];
E←NOMV:E[E];
GO TO REEVAL;
END
ELSE IF ETYP=LOC(FORCE) THEN
RETURN(NEW_SVAL(0)) ! No idea what the actual value will be;
ELSE IF ETYP≠LOC(EXPRN) THEN
BEGIN
USERERR(1,1,"EVALEXPR: BAD ARGUMENT");
RETURN(NULL_RECORD);
END;
C←EXPRN:ARGS[E];
IF C≠NULL_RECORD THEN V1←TFCVT(EVALEXPR(LLOP(C),WLD));
IF C≠NULL_RECORD THEN V2←TFCVT(EVALEXPR(LLOP(C),WLD));
IF C≠NULL_RECORD THEN V3←TFCVT(EVALEXPR(LLOP(C),WLD));
CASE EXPRN:OP[E] OF
BEGIN
[NO_OP] RETURN(V1); ! Added by RF;
[SADD_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]+SVAL:VAL[V2]));
[SSUB_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]-SVAL:VAL[V2]));
[SLT_OP] RETURN(E); ! Does not really have a value;
[SEQ_OP] RETURN(E);
[SLE_OP] RETURN(E);
[SGE_OP] RETURN(E);
[SNE_OP] RETURN(E);
[SGT_OP] RETURN(E);
[AND_OP] RETURN(E);
[OR_OP] RETURN(E);
[NOT_OP] RETURN(E);
[SNEG_OP] RETURN(NEW_SVAL(-SVAL:VAL[V1])); ! Added by RF;
[SMUL_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]*SVAL:VAL[V2]));
[SDIV_OP] RETURN(NEW_SVAL(SVAL:VAL[V1]/SVAL:VAL[V2]));
[VMAGN_OP] RETURN(NEW_SVAL(SQRT(V3DOT(V1,V1)))); ! Modified by RF;
[VDOT_OP] RETURN(NEW_SVAL(V3DOT(V1,V2))); ! Added by RF;
[RMAGN_OP] RETURN(RMAGN(V1)); ! Added by ARG;
[AXIS_OP] RETURN(AXIS(V1)); ! Added by ARG;
[SVMUL_OP] RETURN(SVMUL(SVAL:VAL[V1],V2));
[VMAKE_OP] RETURN(NEW_V3ECT(SVAL:VAL[V1],SVAL:VAL[V2],SVAL:VAL[V3]));
[VADD_OP] RETURN(V3ADD(V1,V2));
[VSUB_OP] RETURN(V3SUB(V1,V2));
[RVMUL_OP] RETURN(RVMUL(V1,V2));
[UVECT_OP] RETURN(UVECT(V1)); ! Added by ARG;
[POS_OP] RETURN(POS(V1)); ! Added by ARG;
[ORIENT_OP] RETURN(ORIENT(V1)); ! Added by ARG;
[AXW_ROTN_OP] RETURN(AXW_ROTN(V1,SVAL:VAL[V2]));
[RRMUL_OP] RETURN(RRMUL(V1,V2));
[TMAKE_OP] RETURN(NEW_TRANS(CHKREC(V1,LOC(ROTN)),CHKREC(V2,LOC(V3ECT)) ));
[TVADD_OP] RETURN(NEW_TRANS(TRANS:R[V1],V3ADD(TRANS:P[V1],V2)));
[TVSUB_OP] RETURN(NEW_TRANS(TRANS:R[V1],V3SUB(TRANS:P[V1],V2)));
[TVMUL_OP] RETURN(TVMUL(V1,V2));
[FTOF_OP] RETURN(TTMUL(TINVRT(CHKREC(V1,LOC(TRANS))),CHKREC(V2,LOC(TRANS))) );
[TTMUL_OP] RETURN(TTMUL(V1,V2));
[TINVRT_OP] RETURN(TINVRT(V1));
[DEPR_OP] BEGIN
IF V2 ≠ RNULL THEN RETURN(V2);
V2 ← DEPR(CELL:CAR[EXPRN:ARGS[E]],WLD); ! in wldmod not arith;
CONSON(V2,EXPRN:ARGS[E]);
RETURN(EVALEXPR(V2,WLD));
END;
[FMAKE_OP] RETURN(NEW_FRAME(
NEW_TRANS(CHKREC(V1,LOC(ROTN)),CHKREC(V2,LOC(V3ECT)) ) ));
[TFMAKE_OP] RETURN(NEW_FRAME(V1));
[SSBRTN_OP] CASE (ETYP←SVAL:VAL[V1]) OF
BEGIN
[SQRT_OP] RETURN(NEW_SVAL(SQRT(SVAL:VAL[V2])));
[SIN_OP] RETURN(NEW_SVAL(SIND(SVAL:VAL[V2])));
[COS_OP] RETURN(NEW_SVAL(COSD(SVAL:VAL[V2])));
[ASIN_OP] RETURN(NEW_SVAL(ASIN(SVAL:VAL[V2]) * DEG));
[ACOS_OP] RETURN(NEW_SVAL(ACOS(SVAL:VAL[V2]) * DEG));
[ATAN2_OP] RETURN(NEW_SVAL(ATAN2(SVAL:VAL[V2],SVAL:VAL[V3]) * DEG))
END;
[LAST_OP] END;
USERERR(1,1,"EVALEXPR: INVALID OP");
RETURN(NULL_RECORD);
END;
! graph munchers
These routines modify graph structures;
IFCR FALSE THENC
INTERNAL RECPROC ADDNEEDED(RPTR(EXPRN,VARIABLE,VALU$) EE;REFERENCE RCELL L);
BEGIN
! adds all variable names needed by EE to list L;
IF RECTYPE(EE)=LOC(EXPRN) THEN
BEGIN
RCELL C;
C←EXPRN:ARGS[EE];
WHILE C≠NULL_RECORD DO
BEGIN
ADDNEEDED(CELL:CAR[C],L);
C←CELL:CDR[C];
END;
END
ELSE IF RECTYPE(EE)=LOC(VARIABLE) THEN
BEGIN
IF ¬IN_CL(EE,L) THEN L←CONS(EE,L);
END;
END;
INTERNAL PROCEDURE ADDDEPS(RVAR VAR;RCELL C;ITEMVAR WLD);
BEGIN
WHILE C≠NULL_RECORD DO
BEGIN
PUT_SET_FLUENT(WLD,VARIABLE:DEPS[CELL:CAR[C]],VAR);
C←CELL:CDR[C];
END;
END;
INTERNAL PROCEDURE ADDCALC(RVAR VAR;RPTR(EXPRN) E;ITEMVAR WLD);
BEGIN
! adds E to calculator set for VAR;
RPTR(CALCULATOR) CLC;
CLC←NEW_RECORD(CALCULATOR);
CALCULATOR:FORM[CLC]←E;
ADDNEEDED(E,CALCULATOR:NEEDED[CLC]);
ADDDEPS(VAR,CALCULATOR:NEEDED[CLC],WLD);
PUT_SET_FLUENT(WLD,VARIABLE:CALCS[VAR],CLC);
END;
INTERNAL PROCEDURE KILLCALC(RVAR VAR;RPTR(EXPRN) E;ITEMVAR WLD);
BEGIN
RCELL NCL,C,CC,NVL;
RPTR(CALCULATOR) CLC;
RPTR(FACT) F;
INTEGER WIX;
WIX←WLDINX(WLD);
NCL←NULL_RECORD;
∀ | GEN_CALCS(WLD,VAR,CLC) DO
BEGIN
F←_FACT_;
IF EXPEQV(CALCULATOR:FORM[CLC],E) THEN
CLRWLD(F,WIX)
ELSE
NCL←CONS(CLC,NCL);
END;
NVL←CALCULATOR:NEEDED[CLC];
WHILE NVL≠NULL_RECORD DO
BEGIN "NVLLP"
RVAR NV;
NV←CELL:CAR[NVL];
NVL←CELL:CDR[NVL];
C←NCL;
WHILE C≠NULL_RECORD DO
BEGIN
CC←CALCULATOR:NEEDED[CELL:CAR[C]];
WHILE CC≠NULL_RECORD DO
IF CELL:CAR[CC]=NV THEN
CONTINUE "NVLLP"
ELSE
CC←CELL:CDR[CC];
C←CELL:CDR[C];
END;
REM_SET_FLUENT(WLD,VARIABLE:DEPS[VAR],NV);
END;
END;
INTERNAL PROCEDURE ONLYCALC(RPTR(VARIABLE) VAR;RPTR(EXPRN) E;ITEMVAR WLD);
BEGIN
RPTR(CALCULATOR) CLC;
RCELL NL;
INTEGER WIX;
WIX←WLDINX(WLD);
∀ | GEN_CALCS(WLD,VAR,CLC) DO
BEGIN
CLRWLD(_FACT_,WIX);
NL←CALCULATOR:NEEDED[CLC];
WHILE NL≠NULL_RECORD DO
BEGIN
REM_SET_FLUENT(WLD,VARIABLE:DEPS[VAR],CELL:CAR[NL]);
NL←CELL:CDR[NL];
END;
END;
ADDCALC(VAR,E,WLD);
END;
ELSEC
ifcr false thenc ! modified graph munchers;
INTERNAL RECPROC ADDNEEDED(RPTR(EXPRN,VARIABLE,VALU$) EE;REFERENCE SET L);
BEGIN
! adds all variable names needed by EE to set L;
IF RECTYPE(EE)=LOC(EXPRN) THEN
BEGIN
RCELL C;
C←EXPRN:ARGS[EE];
WHILE C≠NULL_RECORD DO
BEGIN
ADDNEEDED(CELL:CAR[C],L);
C←CELL:CDR[C];
END;
END
ELSE IF RECTYPE(EE)=LOC(VARIABLE) THEN
BEGIN
PUT VARIABLE:NAME[EE] IN L;
END;
END;
INTERNAL PROCEDURE ADDDEPS(RVAR VAR;SET DL;ITEMVAR WLD);
BEGIN
WHILE LENGTH(DL) DO
BEGIN
RPTR(VARIABLE) ITEMVAR DVI;
DVI←LOP(DL);
PUT_SET_FLUENT(WLD,VARIABLE:DEPS[∂(DVI)],VAR);
END;
END;
INTERNAL RPTR(CALCULATOR) PROCEDURE FINDCALC(RVAR VAR;
RPTR(EXPRN) E;ITEMVAR WLD);
BEGIN
RPTR(CALCULATOR) CLC;
∀ | GEN_CALCS(WLD,VAR,CLC) DO
BEGIN
IF EXPEQV(CALCULATOR:FORM[CLC],E) THEN RETURN(CLC);
END;
RETURN(NULL_RECORD);
END;
INTERNAL RPTR(CALCULATOR) PROCEDURE ADDCALC(RVAR VAR;
RPTR(EXPRN) E;ITEMVAR WLD);
BEGIN
! adds E to calculator set for VAR;
RPTR(CALCULATOR) CLC;
CLC←FINDCALC(VAR,E,WLD);
IF CLC=NULL_RECORD THEN
BEGIN
CLC←NEW_RECORD(CALCULATOR);
CALCULATOR:FORM[CLC]←E;
ADDNEEDED(E,CALCULATOR:NEEDED[CLC]);
ADDDEPS(VAR,CALCULATOR:NEEDED[CLC],WLD);
PUT_SET_FLUENT(WLD,VARIABLE:CALCS[VAR],CLC);
END;
RETURN(CLC);
END;
INTERNAL PROCEDURE KILLCALC(RVAR VAR;RPTR(CALCULATOR) CLC;ITEMVAR WLD);
BEGIN
RPTR(CALCULATOR) C;
RPTR(VARIABLE) ITEMVAR VI;
SET NEEDNOMORE;
REM_SET_FLUENT(WLD,VARIABLE:CALCS[VAR],CLC);
NEEDNOMORE←CALCULATOR:NEEDED[CLC];
∀ | GEN_CALCS(WLD,VAR,C) DO
BEGIN
! find what variables VAR still depends on;
NEEDNOMORE←NEEDNOMORE-CALCULATOR:NEEDED[C];
IF ¬LENGTH(NEEDNOMORE) THEN DONE;
END;
WHILE LENGTH(NEEDNOMORE) DO
BEGIN
VI←LOP(NEEDNOMORE);
REM_SET_FLUENT(WLD,VARIABLE:DEPS[∂(VI)],VAR);
END;
END;
INTERNAL PROCEDURE NOCALCS(RPTR(VARIABLE) VAR;ITEMVAR WLD);
BEGIN
RPTR(CALCULATOR) CLC;
RPTR(VARIABLE) ITEMVAR VI;
INTEGER WIX;
WIX←WLDINX(WLD);
∀ | GEN_CALCS(WLD,VAR,CLC) DO
BEGIN
CLRWLD(_FACT_,WIX);
∀ VI | VI ε CALCULATOR:NEEDED[CLC] DO
REM_SET_FLUENT(WLD,VARIABLE:DEPS[∂(VI)],VAR);
END;
END;
INTERNAL RPTR(CALCULATOR) PROCEDURE ONLYCALC(RPTR(VARIABLE) VAR;
RPTR(EXPRN) E;ITEMVAR WLD);
BEGIN
NOCALCS(VAR,WLD);
RETURN(ADDCALC(VAR,E,WLD));
END;
endc
! yet another version of graph munchers;
INTERNAL RECPROC ADDNEEDED(RPTR(EXPRN,VARIABLE,VALU$) EE;REFERENCE SET L);
BEGIN
! adds all variable names needed by EE to set L;
IF RECTYPE(EE)=LOC(EXPRN) THEN
BEGIN
RCELL C;
C←EXPRN:ARGS[EE];
WHILE C≠NULL_RECORD DO
BEGIN
ADDNEEDED(CELL:CAR[C],L);
C←CELL:CDR[C];
END;
END
ELSE IF RECTYPE(EE)=LOC(VARIABLE) THEN
BEGIN
PUT VARIABLE:NAME[EE] IN L;
END;
END;
INTERNAL RPTR(CALCULATOR) PROCEDURE NEW_CALC(RPTR(EXPRN,VARIABLE,VALU$) E);
BEGIN
RPTR(CALCULATOR) C;
C←NEW_RECORD(CALCULATOR);
CALCULATOR:FORM[C]←E;
CALCULATOR:DEPS[C]←NEW_SET_FLUENT;
CALCULATOR:PLNVAL[C]←NEW_FLUENT;
ADDNEEDED(E,CALCULATOR:NEEDED[C]);
RETURN(C);
END;
INTERNAL PROCEDURE MK_CALC(ITEMVAR WLD;RPTR(CALCULATOR) CLC);
BEGIN
RPTR(VARIABLE) ITEMVAR VI;
∀ VI | VI ε CALCULATOR:NEEDED[CLC] DO
PUT_SET_FLUENT(WLD,VARIABLE:DEPS[∂(VI)],CLC);
END;
INTERNAL PROCEDURE ADDCALC(ITEMVAR WLD;RPTR(VARIABLE) VAR;RPTR(CALCULATOR) CLC);
BEGIN
PUT_SET_FLUENT(WLD,VARIABLE:CALCS[VAR],CLC);
PUT_SET_FLUENT(WLD,CALCULATOR:DEPS[CLC],VAR);
END;
INTERNAL PROCEDURE REMCALC(ITEMVAR WLD;RPTR(VARIABLE) VAR;RPTR(CALCULATOR) CLC);
BEGIN
GETVALUE(VAR,WLD); ! in case VAR needs this one;
REM_SET_FLUENT(WLD,VARIABLE:CALCS[VAR],CLC);
REM_SET_FLUENT(WLD,CALCULATOR:DEPS[CLC],VAR);
END;
INTERNAL PROCEDURE KILLCALC(ITEMVAR WLD;RPTR(CALCULATOR) CLC);
BEGIN
RPTR(VARIABLE) ITEMVAR VI;
RPTR(VARIABLE) VAR;
∀ | GEN_DEPS(WLD,CLC,VAR) DO
REMCALC(WLD,VAR,CLC);
NOFREC(WLD,CALCULATOR:PLNVAL[CLC]);
∀ VI | VIεCALCULATOR:NEEDED[CLC] DO
REM_SET_FLUENT(WLD,VARIABLE:DEPS[∂(VI)],CLC);
END;
INTERNAL PROCEDURE REMCHG(ITEMVAR WLD;RPTR(VARIABLE) VAR;RPTR(CHANGER) CHG);
BEGIN
REM_SET_FLUENT(WLD,VARIABLE:CHANGERS[VAR],CHG);
REM_SET_FLUENT(WLD,CHANGER:TRIGGERS[CHG],VAR);
END;
INTERNAL PROCEDURE ADDCHG(ITEMVAR WLD;RPTR(VARIABLE) VAR;RPTR(CHANGER) CHG);
BEGIN
PUT_SET_FLUENT(WLD,VARIABLE:CHANGERS[VAR],CHG);
PUT_SET_FLUENT(WLD,CHANGER:TRIGGERS[CHG],VAR);
END;
INTERNAL PROCEDURE KILLCHG(ITEMVAR WLD;RPTR(CHANGER) CHG);
BEGIN
RPTR(VARIABLE) V;
∀ | SATISFY_SET_FLUENT(WLD,CHANGER:TRIGGERS[CHG],V) DO
REMCHG(WLD,V,CHG);
END;
INTERNAL PROCEDURE KILLVAR(ITEMVAR WLD;RPTR(VARIABLE) VAR);
BEGIN
RPTR(CHANGER) C;RPTR(VARIABLE,CALCULATOR) D;
∀ | GEN_DEPS(WLD,VAR,D) DO
KILLCALC(WLD,D); ! this will also do the REMCALC;
∀ | GEN_CHANGERS(WLD,VAR,C) DO
REMCHG(WLD,VAR,C);
NOFREC(WLD,VARIABLE:PLNVAL[VAR]);
END;
END $$PRGID;